HPAVC/HPAVC CD-ROM.iso/pc/PXDTUT3.ZIP/PXDTUT3.PAS

Pascal/Delphi Source File | 1997-06-01 | 18.2 KB | 778 lines

program PXDTUT3;

uses
 crt;

CONST
 VGA = $a000;

 Num_of_points = 8;
 Num_of_faces = 6;

 Xofs = 160;
 yofs = 100;
 Zeye = -200;


TYPE
  PointT = record
             x,y,z : integer;
          end;                                {6 bytes pr point}

  ScrPointT = record
               x,y : integer;                 {4 bytes pr point}
             end;

  FaceT = record
           P1,P2,P3,P4 : integer;             {9 bytes pr face}
           color  : byte;
         end;


  PointRecord    = Array[1..Num_of_points] of PointT;    {points *  6 bytes}
  FaceRecord     = Array[1..Num_of_faces] of FaceT;      {faces  *  9 bytes}
  ScrPointRecord = Array[1..Num_of_points] of ScrPointT; {points *  4 bytes}
  CenterRecord   = Array[1..Num_of_faces] of integer;    {faces  *  2 bytes}

  Virtualscreen = Array[1..64000] of byte;
  Virscr = ^VirtualScreen;

VAR
 lookup     : Array [0..360,1..2] of integer; {Our sin and cos lookup table}
 Baseobj    : PointRecord;       {original 3d-object}
 Faces      : FaceRecord;        {data for how faces is defined}
 Points     : PointRecord;       {rotated 3d-object}
 Translated : ScrPointRecord;    {the 2d-screenpoints for drawing}
 Centers    : CenterRecord;      {Z-val of centers for depth sorting}
 OrderTable : Array[1..Num_of_faces] of integer; {how to handle faces correct}

 Xrot,Yrot, Zrot : integer;
 scr2 : virscr;
 vaddr : word;


PROCEDURE WaitRetrace;
Assembler;
label l1,l2;

asm
 mov dx,3DAh
l1:
  in al,dx
  and al,08h
  jnz l1
l2:
  in al,dx
  and al,08h
  jz l2
END;


Procedure FlipScreen(source, dest : word);
Assembler; {386 only}
asm
  mov     dx, ds
  mov     ax, [dest]
  mov     es, ax
  mov     ax, [source]
  mov     ds, ax
  xor     si, si
  xor     di, di
  mov     cx, 16000
  db      $66
  rep     movsw
  mov     ds,dx    {mov's are faster than push / pops }
end;

Procedure Clear (Col : Byte;where:word);
Assembler;
     asm
        mov     cx, 32000;
        mov     ax,where
        mov     es,ax
        xor     di,di
        mov     al,[col]
        mov     ah,al
        rep     stosw
      END;

Procedure PurplePal;
var
 taeller : integer;
begin
 for taeller := 0 to 63 do
   begin   {63 shades from black to purple}
    port[$3C8] := taeller;
    port[$3C9] := taeller;
    port[$3C9] := 0;
    port[$3C9] := taeller;
   end;
end;



Procedure HorLine(Xbegin, Xend,Ypos : integer;color : byte;where : word);
Assembler;
asm
 mov cx,[Xend]
 inc cx
 sub cx,[Xbegin]   {cx = length of line - used for counter }
                   {note, I assume that Xbegin < Xend - the poly routine}
                   {will take care of that...}
 mov ax,[ypos]
 shl ax,8
 mov di,ax
 shr ax,2
 add di,ax
 add di,[Xbegin]   {di = Ypos * 320 + Xbegin - offset for our line}
 mov es,[where]    {where to draw..}

 mov al,[color]
 rep stosb         {I draw byte by byte - slower than drawing a word at a}
                   {time but it is because of the changes we are going to}
                   {make to this routine when glenzing/gouraud/texturemapping}
end;


PROCEDURE GlenzHorline(xb,xe,y:integer; c:byte;where : word); assembler;
asm
  mov bx,[xb]
  mov cx,[xe]
  inc cx
  sub cx,bx             { length of line in cx }
  mov es,Where         { segment to draw in }
  mov ax,[y]            { heigth of line }
  shl ax,8
  mov di,ax
  shr ax,2
  add di,ax             { y*320 in di (offset) }
  add di,bx             { add x-begin }

 @again:
  mov al,es:[di]
  add al,[c]
  stosb
  dec cx
  cmp cx,0
  jne @again
 @out:
end;



Procedure Polygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;color : byte; where : word);
var
 counter : integer;
 Ymin, Ymax : integer;
 polygon : Array[0..199,1..2] of integer;

Procedure ScanPolySide(X1,Y1,X2,Y2 : integer);
var
 DeltaX : integer;
 temp : integer;
 Xposfixed,Xpos : integer;
 counter : integer;
begin
  if Y2=Y1 then exit;          {exit if side is a horizontal line }
  if (Y2<Y1) then              {make sure Y1 is top point}
               begin
                 temp := Y1;
                 Y1 := Y2;
                 Y2 := temp;

                 temp := X1;
                 X1 := X2;
                 X2 := temp;   {switch the points if Y1 is not top..}
               end;

  DeltaX := ((X2-X1) shl 7) div (Y2-Y1); {DeltaX in 9.7 fixed point math}
  Xposfixed := X1 shl 7; {Xpos in 9.7 fixed point math }
    for counter := Y1 to Y2 do
         begin
           Xpos := XposFixed shr 7;
           if (Xpos < polygon[counter,1]) then polygon[counter,1] := Xpos;
           if (Xpos > polygon[counter,2]) then polygon[counter,2] := Xpos;
           Xposfixed := XposFixed + DeltaX;
         end;
end;


begin
 Ymin := Y1;
 Ymax := Y1;
 if (Y2 < Ymin) then Ymin := Y2;
 if (Y2 > Ymax) then Ymax := Y2;
 if (Y3 < Ymin) then Ymin := Y3;
 if (Y3 > Ymax) then Ymax := Y3;
 if (Y4 < Ymin) then Ymin := Y4;
 if (Y4 > Ymax) then Ymax := Y4;  {what is Ymin and Ymax in this polygon ?}

 if (Ymin < 0) then Ymin := 0;
 if (Ymax > 199) then Ymax := 199;

 for counter := 0 to 199 do
   begin
     polygon[counter,1] := 32000;
     polygon[counter,2] := -32000;
   end;

 {we have to initialize our variable 'polygon' to some extreme values}

 ScanPolySide(X1,Y1,X2,Y2);
 ScanPolySide(X2,Y2,X3,Y3);
 ScanPolySide(X3,Y3,X4,Y4);
 ScanPolySide(X4,Y4,X1,Y1); {all four sides scanned}

 for counter := Ymin to Ymax do
    Horline(polygon[counter,1],polygon[counter,2],counter,color,where);
end;


Procedure GlenzPolygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;color : byte; where : word);
var
 counter : integer;
 Ymin, Ymax : integer;
 polygon : Array[0..199,1..2] of integer;

Procedure ScanPolySide(X1,Y1,X2,Y2 : integer);
var
 DeltaX : integer;
 temp : integer;
 Xposfixed,Xpos : integer;
 counter : integer;
begin
  if Y2=Y1 then exit;          {exit if side is a horizontal line }
  if (Y2<Y1) then              {make sure Y1 is top point}
               begin
                 temp := Y1;
                 Y1 := Y2;
                 Y2 := temp;

                 temp := X1;
                 X1 := X2;
                 X2 := temp;   {switch the points if Y1 is not top..}
               end;

  DeltaX := ((X2-X1) shl 7) div (Y2-Y1); {DeltaX in 9.7 fixed point math}
  Xposfixed := X1 shl 7; {Xpos in 9.7 fixed point math }
    for counter := Y1 to Y2 do
         begin
           Xpos := XposFixed shr 7;
           if (Xpos < polygon[counter,1]) then polygon[counter,1] := Xpos;
           if (Xpos > polygon[counter,2]) then polygon[counter,2] := Xpos;
           Xposfixed := XposFixed + DeltaX;
         end;
end;


begin
 Ymin := Y1;
 Ymax := Y1;
 if (Y2 < Ymin) then Ymin := Y2;
 if (Y2 > Ymax) then Ymax := Y2;
 if (Y3 < Ymin) then Ymin := Y3;
 if (Y3 > Ymax) then Ymax := Y3;
 if (Y4 < Ymin) then Ymin := Y4;
 if (Y4 > Ymax) then Ymax := Y4;  {what is Ymin and Ymax in this polygon ?}

 if (ymin < 0) then Ymin := 0;
 if (Ymax > 199) then Ymax := 199;

 for counter := 0 to 199 do
   begin
     polygon[counter,1] := 32000;
     polygon[counter,2] := -32000;
   end;

 {we have to initialize our variable 'polygon' to some extreme values}

 ScanPolySide(X1,Y1,X2,Y2);
 ScanPolySide(X2,Y2,X3,Y3);
 ScanPolySide(X3,Y3,X4,Y4);
 ScanPolySide(X4,Y4,X1,Y1); {all four sides scanned}

 for counter := Ymin to Ymax do
    GlenzHorline(polygon[counter,1],polygon[counter,2],counter,color,where);
end;



PROCEDURE SetUpVirtual(VAR screenname:virscr;VAR add : word);
BEGIN
  GetMem (Screenname,64000);
  add := seg (Screenname^);
  clear(0,add);
END;

PROCEDURE ShutDown(Screenname:virscr);
BEGIN
  FreeMem (Screenname,64000);
END;


Function rad (theta : real) : real;
BEGIN
  rad := theta * pi / 180
END;

Procedure Calc_Cos_sin;
var
 loop1 : integer;
begin
 For loop1:=0 to 360 do
   BEGIN
    lookup [loop1,1]:=round(sin (rad (loop1))*16384);
    lookup [loop1,2]:=round(cos (rad (loop1))*16384);
   END;
end;

FUNCTION Xconv(X,Z : integer):integer;
BEGIN
 Xconv:=Xofs+Round(X*(Zeye/(Zeye-Z)));
END;

FUNCTION Yconv(Y,Z : integer):integer;
BEGIN
 Yconv:=Yofs+Round(Y*(Zeye/(Zeye-Z)));
END;

Procedure Init_Object;
var
 taeller : integer;
begin
  baseobj[1].X := -50;
  baseobj[1].Y := -50;
  baseobj[1].Z := -50;

  baseobj[2].X :=  50;
  baseobj[2].Y := -50;
  baseobj[2].Z := -50;

  baseobj[3].X := -50;
  baseobj[3].Y :=  50;
  baseobj[3].Z := -50;

  baseobj[4].X :=  50;
  baseobj[4].Y :=  50;
  baseobj[4].Z := -50;

  baseobj[5].X := -50;
  baseobj[5].Y := -50;
  baseobj[5].Z :=  50;

  baseobj[6].X :=  50;
  baseobj[6].Y := -50;
  baseobj[6].Z :=  50;

  baseobj[7].X := -50;
  baseobj[7].Y :=  50;
  baseobj[7].Z :=  50;

  baseobj[8].X :=  50;
  baseobj[8].Y :=  50;
  baseobj[8].Z :=  50;

  faces[1].P1 :=   1;
  faces[1].P2 :=   2;
  faces[1].P3 :=   4;
  faces[1].P4 :=   3;

  faces[2].P1 :=   2;
  faces[2].P2 :=   6;
  faces[2].P3 :=   8;
  faces[2].P4 :=   4;

  faces[3].P1 :=   5;
  faces[3].P2 :=   7;
  faces[3].P3 :=   8;
  faces[3].P4 :=   6;

  faces[4].P1 :=   1;
  faces[4].P2 :=   3;
  faces[4].P3 :=   7;
  faces[4].P4 :=   5;

  faces[5].P1 :=   1;
  faces[5].P2 :=   5;
  faces[5].P3 :=   6;
  faces[5].P4 :=   2;

  faces[6].P1 :=   3;
  faces[6].P2 :=   4;
  faces[6].P3 :=   8;
  faces[6].P4 :=   7;

  for taeller := 1 to Num_of_faces do
     faces[taeller].color :=  0 + taeller * 3;
end;

Procedure RotatePoint (Xrot,Yrot,Zrot,Xin,Yin,Zin:Integer;var Xout,Yout,Zout : integer);
VAR
  a,b,c:integer;
BEGIN
      b:=lookup[Yrot,2];
      c:=Xin;
      asm
        mov   ax,b
        imul  c
        sal   ax,1
        rcl   dx,1
        sal   ax,1
        rcl   dx,1
        mov   a,dx
      end;
      b:=lookup[Yrot,1];
      c:=Zin;
      asm
        mov   ax,b
        imul  c
        sal   ax,1
        rcl   dx,1
        sal   ax,1
        rcl   dx,1
        add   a,dx
      end;
      Xout:=a;
      Yout:=Yin;
      b:=-lookup[Yrot,1];
      c:=Xin;
      asm
        mov   ax,b
        imul  c
        sal   ax,1
        rcl   dx,1
        sal   ax,1
        rcl   dx,1
        mov   a,dx
      end;
      b:=lookup[Yrot,2];
      c:=Zin;
      asm
        mov   ax,b
        imul  c
        sal   ax,1
        rcl   dx,1
        sal   ax,1
        rcl   dx,1
        add   a,dx
      end;
      Zout:=a;

  if (Xrot<>0) THEN
     BEGIN
        b:=lookup[Xrot,2];
        c:=Yout;
        asm
          mov   ax,b
          imul  c
          sal   ax,1
          rcl   dx,1
          sal   ax,1
          rcl   dx,1
          mov   a,dx
        end;
        b:=lookup[Xrot,1];
        c:=Zout;
        asm
          mov   ax,b
          imul  c
          sal   ax,1
          rcl   dx,1
          sal   ax,1
          rcl   dx,1
          sub   a,dx
        end;
        b:=lookup[Xrot,1];
        c:=Yout;
        Yout:=a;
        asm
          mov   ax,b
          imul  c
          sal   ax,1
          rcl   dx,1
          sal   ax,1
          rcl   dx,1
          mov   a,dx
        end;
        b:=lookup[Xrot,2];
        c:=Zout;
        asm
          mov   ax,b
          imul  c
          sal   ax,1
          rcl   dx,1
          sal   ax,1
          rcl   dx,1
          add   a,dx
        end;
        Zout:=a;
     END; {if Xrot <> 0 }


 if (Zrot<>0) THEN
     BEGIN
        b:=lookup[Zrot,2];
        c:=Xout;
        asm
          mov   ax,b
          imul  c
          sal   ax,1
          rcl   dx,1
          sal   ax,1
          rcl   dx,1
          mov   a,dx
        end;
        b:=lookup[Zrot,1];
        c:=Yout;
        asm
          mov   ax,b
          imul  c
          sal   ax,1
          rcl   dx,1
          sal   ax,1
          rcl   dx,1
          sub   a,dx
        end;
        b:=lookup[Zrot,1];
        c:=Xout;
        Xout:=a;
        asm
          mov   ax,b
          imul  c
          sal   ax,1
          rcl   dx,1
          sal   ax,1
          rcl   dx,1
          mov   a,dx
        end;
        b:=lookup[Zrot,2];
        c:=Yout;
        asm
          mov   ax,b
          imul  c
          sal   ax,1
          rcl   dx,1
          sal   ax,1
          rcl   dx,1
          add   a,dx
        end;
        Yout:=a;
     END; {if Zrot <> 0 }
END; {This one I grapped from some Asphyxia tuturial.... thnx Denthor }



Procedure Rotateobj(x,y,z : integer);
{Rotates all points and calculates center Z-val for sorting}
var
 taeller : integer;
begin
 for taeller := 1 to num_of_points do
  RotatePoint(x,y,z,baseobj[taeller].x,baseobj[taeller].y,baseobj[taeller].z,
              points[taeller].x,points[taeller].y,points[taeller].z);


 for taeller := 1 to num_of_faces do
    centers[taeller] :=
     (points[faces[taeller].P1].Z + points[faces[taeller].P2].Z +
      points[faces[taeller].P3].Z + points[faces[taeller].P4].Z);
    {average Z-val for face. NOTE : SHOULD divide by 4.. but that is really}
    {not nessesary. This way all the values will be the correct val times 4}
    {As ALL values is 4 times too big they will still sort correct :)      }
end;


Procedure Sort_faces;
{Just a simple bubble-sort - not to fast but what the heck :) }
{Faces with the HIGHEST Z-val is placed first in Order[] }
VAR
  counter : integer;
  position : integer;
  tempval : integer;
BEGIN
  for counter:=1 to Num_of_faces do BEGIN
    OrderTable[counter]:=counter;
  END;
  {we resets the ordertable so that it matches the unsorted 'centers' variable}
  position := 1;

  repeat
    if (centers[position] < centers[position+1]) then
        BEGIN   {switch values in centers and ordertable}
          tempval := Centers[position+1];
          Centers[position+1] := centers[position];
          centers[position] := tempval;

          tempval := OrderTable[position+1];
          OrderTable[position+1] := OrderTable[position];
          OrderTable[position] := tempval;

          position:=1;   {start loop over}
        END;
      inc(position);
  until (position = Num_of_faces);  {all way through without changes}
END;


Procedure Project_points;
var
 taeller : integer;
begin
 for taeller := 1 to Num_of_points do
    begin
      translated[taeller].X := Xconv(points[taeller].X,points[taeller].Z);
      translated[taeller].Y := Yconv(points[taeller].Y,points[taeller].Z);
     end;
end;

Procedure Do_faces(where : word);
{This one can be used for all kinds of fills : solid, textures, glenz...}
var
 taeller : integer;
 X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;
 color : byte;
 polynr : integer;
 normal : integer;
begin
 for taeller := 1 to Num_of_faces do
   begin
     polynr := OrderTable[taeller];
     X1 := translated[faces[polynr].P1].X;
     Y1 := translated[faces[polynr].P1].Y;
     X2 := translated[faces[polynr].P2].X;
     Y2 := translated[faces[polynr].P2].Y;
     X3 := translated[faces[polynr].P3].X;
     Y3 := translated[faces[polynr].P3].Y;
     X4 := translated[faces[polynr].P4].X;
     Y4 := translated[faces[polynr].P4].Y;
     color := faces[polynr].color;

     {*******************************************************}
     {******* HIDDEN FACE REMOVAL - YES, THAT EASY ;) *******}
     {*******************************************************}
     {Z-Comp of normal}
     normal := (Y1-Y3)*(X2-X1) - (X1-X3)*(Y2-Y1);
       if (normal < 0) then
         Polygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4,color,where);
     {*******************************************************}
     {*******************************************************}
     {*******************************************************}
   end;
end;


Procedure DoGlenzing(where : word);
var
 taeller : integer;
 X1,Y1,X2,Y2,X3,Y3,X4,Y4 : integer;
 color : byte;
begin
 for taeller := 1 to Num_of_faces do
   begin
     X1 := translated[faces[taeller].P1].X;
     Y1 := translated[faces[taeller].P1].Y;
     X2 := translated[faces[taeller].P2].X;
     Y2 := translated[faces[taeller].P2].Y;
     X3 := translated[faces[taeller].P3].X;
     Y3 := translated[faces[taeller].P3].Y;
     X4 := translated[faces[taeller].P4].X;
     Y4 := translated[faces[taeller].P4].Y;
     color := faces[taeller].color;

     GlenzPolygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4,color,where);
   end;
end;



BEGIN

Clrscr;
Writeln('      ****************************************************************');
Writeln('      *                                                              *');
Writeln('      *                    3D BASIC OBJECT ENGINE                    *');
Writeln('      *                        by : Telemachos                       *');
Writeln('      *                                                              *');
Writeln('      ****************************************************************');
Writeln;
Writeln;
Writeln('      Hiya! ');
Writeln('      Welcome to the Peroxide Programming Tips #3');
Writeln('      This one is on 3D objects - starting out with the basics of 3D');
Writeln('      programming.');
Writeln;
Writeln('      This small demo contains two small parts. The first is a demo ');
Writeln('      of the theory on face sorting and hidden face removal we learned');
Writeln('      in the textfile.');
Writeln('      The other part is a demo of the glenzing effect.');
Writeln('      Press any key to change from the first to the second part..');
Writeln;
Writeln('      Hit any key to start.....');


readkey;

 asm
   mov ax,13h
   int 10h
 end;

SetupVirtual(scr2,vaddr);


Calc_cos_sin;
Init_Object;

Clear(0,VGA);

Xrot := 0;
Yrot := 0;
Zrot := 0;


repeat
 Rotateobj(Xrot,Yrot,Zrot);

 Xrot := (Xrot + 2) mod 360;
 Yrot := (Yrot + 4) mod 360;
 Zrot := (Zrot + 1) mod 360;
 Clear(0,Vaddr);

 Project_Points;
 Sort_faces;
 Do_faces(Vaddr);

 waitretrace;
 FlipScreen(vaddr,VGA);

until keypressed;
readkey;


PurplePal; {set up linear pallette for glenzing... not the best way to glenz}

repeat
 Rotateobj(Xrot,Yrot,Zrot);

 Xrot := (Xrot + 2) mod 360;
 Yrot := (Yrot + 4) mod 360;
 Zrot := (Zrot + 1) mod 360;
 Clear(0,Vaddr);

 Project_Points;
 DoGlenzing(vaddr);

 waitretrace;
 FlipScreen(vaddr,VGA);
until keypressed;
readkey;


ShutDown(scr2);

asm
 mov ax,03h
 int 10h
end;

END.